; ORIGINAL: 3dt2.1/examples/findents.scm
; $Id: findents.scm,v 1.4 1997/04/30 20:24:10 jread Exp $
;- findents.scm -------------------------------------------------
; Find and display a list of entities
; The parameter "what" restricts the list to entities with a
; specified string in their name.
;----------------------------------------------------------------

; Bind find-ents to the top level environment, so that it can
; find all of the entities.
(define find-ents)

; Define the procedure got-one which outputs the the symbol name
; and the entity type of symbol.
(let ((found))
  (define (got-one sym)
    (if (bound? sym)
      (begin
         (set! found #t)
         (format #t "~s ~s ~%" (symbol->string sym)
                               (entity:debug (eval sym))
         )
      )
   )
)

; Define the procedure find-ents which searchs the current
; environment object list and find those symbol names which are
; of type entity.
;
; It first checks to see if the object passed is a symbol.  If it
; is not a valid symbol, an error is reported.
;
; Next, it loops over oblist, which is a list of object lists.  Thus,
; it takes each sub-list and loops over all of the compoment object
; and then goes on to the next sub-list.
;
; If the object name contains the string passed, it is then tested
; to see if it is bound to the current environment.  If this is the
; case, the object is checked to see if it is of type entity.  If
; this is the case, the procedure got-one is called.  If any of
; these fail, the next object is processed.
;
; If no object are found which contain the string passed, a message
; is returned as such.
;
; Once all of the objects have been processed, the procedure
; returns #v, or null.

(set! find-ents
   (lambda (what)
      (if (symbol? what)
         (set! what (symbol->string what))
         (if (not (string? what))
            (error 'find-ents "string or symbol expected")
         )
      )
      (set! found #f)
      (do ((tail (oblist) (cdr tail))) ((null? tail))
         (do ((l (car tail) (cdr l))) ((null? l))
            (if (substring? what (symbol->string (car l)))
               (if (bound? (car l))
                  (if (entity? (eval (car l)))
                     (got-one (car l))
                  )
               )
            )
         )
      )
      (if (not found)
         (format #t "~a: nothing appropriate~%" what)
      )
   #v)
   )
)
